home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / apg_2.exe / PHONE.S&M < prev    next >
Text File  |  1993-03-18  |  20KB  |  780 lines
  1. ''''''''''''''''''''''''''''''''''''''''''''''''''
  2. '                                                '
  3. '                General Phone List              '
  4. '                ------------------              '
  5. '                                                '
  6. '                 CREATED BY APG                 '
  7. '                 S & M SOFTWARE                 '
  8. '                 COPYRIGHT 1993                 '
  9. '                                                '
  10. '              USE file is PHONE.USE             '
  11. '                                                '
  12. '  Author: S&M Software                          '
  13. '  Date:   03-18-1993                            '
  14. '  Time:   10:39:13                              '
  15. '                                                '
  16. '  USE file Created         USE file Modified    '
  17. '  Date:   03-10-1993       Date:   03-14-1993   '
  18. '  Time:   22:50:08         Time:   11:18:01     '
  19. ''''''''''''''''''''''''''''''''''''''''''''''''''
  20.  
  21.  
  22. DEFINT A-Z
  23. CONST FALSE = 0, TRUE = NOT FALSE
  24. TYPE rectype                                'Define variables for file
  25.    pnbr AS STRING * 12
  26.    xName20 AS STRING * 30
  27.    xAddress AS STRING * 25
  28.    xcity40 AS STRING * 20
  29.    xstate50 AS STRING * 2 
  30.    xZip60 AS STRING * 10
  31.    xSpouse AS STRING * 10
  32.    xData80 AS STRING * 8 
  33.    xGift90 AS INTEGER
  34.    sts AS STRING * 1
  35. END TYPE
  36. TYPE indextype                              'Define index
  37.    recnum AS INTEGER
  38.    pnbr AS STRING * 12
  39. END TYPE
  40. DECLARE FUNCTION getinput$ (work$, fl%, nflg$, plen, prec, form$, act$, mode$)
  41. DECLARE SUB arrow (mode$, opt$, tracfld)
  42. DECLARE SUB clearfore ()
  43. DECLARE SUB displaydata ()
  44. DECLARE SUB export ()
  45. DECLARE SUB message (msg$, resp$)
  46. DECLARE SUB newrec (recnum, numofrec, maxrec, newkey$, exit$, mode$)
  47. DECLARE SUB nextrec (direc$, exit$, numofrec, recnum)
  48. DECLARE SUB sortindex ()
  49. DIM SHARED numofrec
  50. DIM SHARED f3.0$
  51. DIM SHARED phone AS rectype
  52. f3.0$ = "####"
  53.  
  54. ON ERROR GOTO errhandle
  55.  
  56. COLOR 15, 0
  57. CLS
  58.  
  59. OPEN "PHONE.DAT" FOR RANDOM AS #1 LEN = LEN(phone)
  60.  
  61. numofrec = LOF(1) \ LEN(phone)
  62. maxrec = numofrec + 100
  63. DIM SHARED index(1 TO maxrec)  AS indextype
  64. IF numofrec <> 0 THEN
  65.    FOR recnum = 1 TO numofrec
  66.       GET #1, recnum, phone
  67.       index(recnum).recnum = recnum
  68.       index(recnum).pnbr = phone.pnbr
  69.    NEXT
  70. END IF
  71. '
  72. '----- Print menu -----'
  73. '
  74. LOCATE 1, 29
  75. COLOR 7, 9
  76. PRINT "│                    │"
  77. LOCATE 1, 31
  78. PRINT "General Phone List"
  79. LOCATE 2, 29
  80. PRINT "│                    │"
  81. LOCATE 2, 31
  82. PRINT "------------------"
  83. sortindex                                   'sort records
  84. recnum = 0                                  'reset record number
  85.  
  86. LOCATE  5, 5: PRINT "01-Phone Number   "
  87. LOCATE  7, 5: PRINT "02-Name           "
  88. LOCATE  8, 5: PRINT "03-Address        "
  89. LOCATE  9, 5: PRINT "04-City           "
  90. LOCATE  10, 5: PRINT "05-State          "
  91. LOCATE  11, 5: PRINT "06-Zip Code       "
  92. LOCATE  13, 5: PRINT "07-Spouse's Name  "
  93. LOCATE  14, 5: PRINT "08-Birthday       "
  94. LOCATE  15, 5: PRINT "09-Gift Amount    "
  95. '
  96. '----- Start processing -----'
  97. '
  98. start:
  99. mode$ = ""
  100. phone.pnbr = ""
  101. phone.xName20 = ""
  102. phone.xAddress = ""
  103. phone.xcity40 = ""
  104. phone.xstate50 = ""
  105. phone.xZip60 = ""
  106. phone.xSpouse = ""
  107. phone.xData80 = ""
  108. phone.xGift90 = 0
  109. phone.sts = ""
  110. nflg$ = ""
  111. clearfore
  112. LOCATE  5,  24
  113. newkey$ = getinput$(phone.pnbr, 12, "L", 0, 0, "", act$, mode$)
  114. IF act$ = "PU" OR act$ = "PD" THEN
  115.    opt$ = act$
  116.    IF recnum = 0 THEN
  117.       IF opt$ = "PU" AND numofrec <> 0 THEN recnum = numofrec + 1
  118.    END IF
  119.    GOTO menu10
  120. END IF
  121. IF newkey$ = "            " GOTO fin
  122. IF UCASE$(newkey$) = "N           " THEN
  123.    opt$ = "N"
  124.    GOTO menu10
  125. END IF
  126. GOTO io
  127. '
  128. '------ Option bar -----'
  129. '
  130. menu:
  131. mode$ = "C"
  132. LOCATE 23, 1
  133. PRINT STRING$(80, " ")
  134. LOCATE 23, 12, 1
  135. COLOR 7, 9
  136. PRINT "FIELD #, PgUp, PgDn, ";
  137. PRINT "All, Next, Back, Delete, Sort, Export";
  138. COLOR 15, 0
  139. PRINT "  "
  140. COLOR 15, 9
  141. LOCATE 23, 18: PRINT "#"
  142. LOCATE 23, 33: PRINT "A"
  143. LOCATE 23, 38: PRINT "N"
  144. LOCATE 23, 44: PRINT "B"
  145. LOCATE 23, 50: PRINT "D"
  146. LOCATE 23, 58: PRINT "S"
  147. LOCATE 23, 64: PRINT "E"
  148.  
  149. COLOR 15, 0
  150. opt$ = ""
  151. menu5:
  152. LOCATE 23, 71
  153. PRINT opt$;
  154. DO
  155. instr$ = INKEY$
  156. LOOP WHILE instr$ = ""
  157.  
  158. IF INSTR("BANDSE", UCASE$(instr$)) > 0 THEN opt$ = instr$: GOTO menu10
  159. IF instr$ = CHR$(13) GOTO menu10
  160. IF instr$ = CHR$(27) GOTO menu
  161. IF instr$ = CHR$(8) GOTO menu
  162. IF LEN(instr$) = 2 THEN
  163.    code = ASC(RIGHT$(instr$, 1))
  164.    IF code = &H49 THEN opt$ = "PU"
  165.    IF code = &H51 THEN opt$ = "PD"
  166.    GOTO menu10
  167. END IF
  168. opt$ = opt$ + instr$
  169. GOTO menu5
  170. '
  171. '----- Start here for action keys -----'
  172. '
  173. menu10:  
  174. resp$ = ""
  175. IF opt$ = "" THEN GOTO start
  176. opt$ = UCASE$(opt$)
  177. IF MID$(opt$, 1, 1) = "0" THEN opt$ = MID$(opt$, 2, 1)
  178. LOCATE 23, 1
  179. PRINT STRING$(80, " ")
  180. LOCATE 23, 6, 1
  181. COLOR 7, 9
  182. IF INSTR("SEBNPUPD", opt$) = 0 THEN
  183. PRINT "Active Keys: <PgUp>, <PgDn>, <Arrows>, <Del>, <Ins>, <Esc> or <Enter>";
  184. COLOR 15, 9
  185. LOCATE 23, 20: PRINT "PgUp";
  186. LOCATE 23, 28: PRINT "PgDn";
  187. LOCATE 23, 36: PRINT "Arrows";
  188. LOCATE 23, 46: PRINT "Del";
  189. LOCATE 23, 53: PRINT "Ins";
  190. LOCATE 23, 60: PRINT "Esc";
  191. LOCATE 23, 69: PRINT "Enter";
  192. END IF
  193. COLOR 15, 0
  194.  
  195. SELECT CASE opt$
  196.    CASE "1"
  197.       message "Can not change index - Press any key", resp$
  198.       GOTO menu
  199.    CASE "2"
  200.       GOTO fld20                             'Name                          
  201.    CASE "3"
  202.       GOTO fld30                             'Address                       
  203.    CASE "4"
  204.       GOTO fld40                             'City                          
  205.    CASE "5"
  206.       GOTO fld50                             'State                         
  207.    CASE "6"
  208.       GOTO fld60                             'Zip Code                      
  209.    CASE "7"
  210.       GOTO fld70                             'Spouse's Name                 
  211.    CASE "8"
  212.       GOTO fld80                             'Birthday                      
  213.    CASE "9"
  214.       GOTO fld90                             'Gift Amount                   
  215.    CASE "A"
  216.       mode$ = "A"
  217.       GOTO fld20
  218.    CASE "N", "PD"
  219.       direc$ = "F"
  220.       nextrec direc$, exit$, numofrec, recnum
  221.       IF exit$ = "A" GOTO start
  222.       GOTO menu
  223.    CASE "B", "PU"
  224.       direc$ = "B"
  225.       nextrec direc$, exit$, numofrec, recnum
  226.       IF exit$ = "A" GOTO start
  227.       GOTO menu
  228.    CASE "D"
  229.       phone.sts = "D"
  230.       GOTO del
  231.    CASE "S"
  232.       resp$ = "1"
  233.       message "Sorting file - Please wait", resp$
  234.       sortindex
  235.       resp$ = "2"
  236.       message "", resp$
  237.    CASE "E"
  238.       CLOSE (2)
  239.       KILL "phone.exp"
  240.       resp$ = "1"
  241.       message "Preparing file for export - Please wait", resp$
  242.       export
  243.       resp$ = "2"
  244.       message "", resp$
  245.       GET #1, recnum, phone
  246. END SELECT
  247. GOTO menu
  248. '
  249. '----- Input fields -----'
  250. '
  251. fld20:                                       'Name                          
  252. tracfld = 2
  253. LOCATE  7,  24
  254. phone.xName20 = getinput$(phone.xName20, 30, "L", 0, 0, "", act$, mode$)
  255. LOCATE 25, 1
  256. PRINT STRING$(80, " ");
  257. IF phone.xName20 = "                              " AND mode$ <> "C" THEN
  258.    GOTO start
  259. END IF
  260. IF mode$ = "C" OR act$ <> "" GOTO add
  261.  
  262. fld30:                                       'Address                       
  263. tracfld = 3
  264. LOCATE  8,  24
  265. phone.xAddress = getinput$(phone.xAddress, 25, "L", 0, 0, "", act$, mode$)
  266. IF mode$ = "C" OR act$ <> "" GOTO add
  267.  
  268. fld40:                                       'City                          
  269. tracfld = 4
  270. LOCATE  9,  24
  271. phone.xcity40 = getinput$(phone.xcity40, 20, "L", 0, 0, "", act$, mode$)
  272. IF mode$ = "C" OR act$ <> "" GOTO add
  273.  
  274. fld50:                                       'State                         
  275. tracfld = 5
  276. LOCATE  10,  24
  277. phone.xstate50 = getinput$(phone.xstate50, 2 , "L", 0, 0, "", act$, mode$)
  278. IF mode$ = "C" OR act$ <> "" GOTO add
  279.  
  280. fld60:                                       'Zip Code                      
  281. tracfld = 6
  282. LOCATE  11,  24
  283. phone.xZip60 = getinput$(phone.xZip60, 10, "L", 0, 0, "", act$, mode$)
  284. IF mode$ = "C" OR act$ <> "" GOTO add
  285.  
  286. fld70:                                       'Spouse's Name